examples.RmdThere are two avalaible options to arrange ggiraph outputs into a grid. As ggiraph is mainly only new geoms, package cowplot and patchwork can be used seamlessly.
library(ggplot2)
library(ggiraph)
library(patchwork)
library(cowplot)
mtcars <- mtcars
mtcars$tooltip <- rownames(mtcars)
theme_set(theme_minimal())
gg1 <- ggplot(mtcars) +
geom_point_interactive(aes(x = drat, y = wt, color = qsec,
tooltip = tooltip, data_id = tooltip ), size = 4)
gg2 <- ggplot(mtcars) +
geom_point_interactive(aes(x = qsec, y = disp, color = mpg,
tooltip = tooltip, data_id = tooltip ), size = 4)library(dplyr)
library(tidyr)
library(ggplot2)
library(ggdendro)
library(purrr)
library(ggiraph)
source("expr.R")
expr_set_extract[1:4, 4:9]## col_4 col_5 col_6 col_7 col_8 col_9
## id_1 3.943339 3.885332 3.972568 3.897985 3.968078 3.840585
## id_2 2.405950 2.364125 3.035228 2.581442 2.476972 2.755192
## id_3 1.845634 1.876945 2.006225 1.917262 2.001037 1.979254
## id_4 3.032080 2.923366 3.011424 3.049322 3.158107 3.008166
First compute data for dendrograms
hc <- hclust(dist(expr_set_extract), "ave")
dhr <- as.dendrogram(hc)
order_r <- rownames(expr_set_extract)[hc$order]
hc <- hclust(dist(t(expr_set_extract)), "ave")
dhc <- as.dendrogram(hc)
order_c <- colnames(expr_set_extract)[hc$order]
data_r <- dendro_data(dhr, type = "rectangle")
data_r <- segment(data_r)
data_r <- data_r %>%
mutate( x_ = y + length(order_c),
xend_ = yend + length(order_c),
y_ = x,
yend_ = xend )
data_c <- dendro_data(dhc, type = "rectangle")
data_c <- segment(data_c) %>% mutate(
y = y + length(order_r),
yend = yend + length(order_r)
)Create a data.frame from the matrix, then order.
expr_set <- bind_cols(
data_frame(gene = rownames(expr_set_extract)),
as.data.frame(expr_set_extract)
)## Warning: `data_frame()` is deprecated, use `tibble()`.
## This warning is displayed once per session.
expr_set <- gather(expr_set, variable, measure, -gene)
expr_set$gene <- factor( expr_set$gene, levels = order_r )
expr_set$variable <- factor( expr_set$variable, levels = order_c )
expr_set <- arrange(expr_set, gene, variable)Add a variable to have tooltips as tables
str_model <- paste0("<tr><td>gene</td><td>%s</td></tr>",
"<tr><td>variable</td><td>%s</td></tr>",
"<tr><td>measure</td><td>%.03f</td></tr>")
expr_set$tooltip <- sprintf(str_model, expr_set$gene,
expr_set$variable, expr_set$measure )
expr_set$tooltip <- paste0( "<table>",
expr_set$tooltip, "</table>" )
head(expr_set)## # A tibble: 6 x 4
## gene variable measure tooltip
## <fct> <fct> <dbl> <chr>
## 1 id_8 col_22 4.21 <table><tr><td>gene</td><td>id_8</td></tr><tr><td…
## 2 id_8 col_20 3.87 <table><tr><td>gene</td><td>id_8</td></tr><tr><td…
## 3 id_8 col_25 3.87 <table><tr><td>gene</td><td>id_8</td></tr><tr><td…
## 4 id_8 col_44 3.27 <table><tr><td>gene</td><td>id_8</td></tr><tr><td…
## 5 id_8 col_45 3.72 <table><tr><td>gene</td><td>id_8</td></tr><tr><td…
## 6 id_8 col_33 3.38 <table><tr><td>gene</td><td>id_8</td></tr><tr><td…
Create the ggplot using geom_tile_interactive
p <- ggplot(data = expr_set, aes(x = variable, y = gene) ) +
geom_tile_interactive(aes(fill = measure, tooltip = tooltip), colour = "white") +
scale_fill_gradient(low = "white", high = "#BC120A", limits = c(0, 13)) +
geom_segment(
data = data_c,
mapping = aes(x = x, y = yend, xend = xend, yend = y),
colour = "gray20", size = .2) +
geom_segment(
data = data_r,
mapping = aes(x = x_, y = y_, xend = xend_, yend = yend_),
colour = "gray20", size = .2) +
coord_equal()Theme the object
p <- p + theme_minimal() +
theme(
legend.position = "right",
panel.grid.minor = element_line(color = "transparent"),
panel.grid.major = element_line(color = "transparent"),
axis.ticks.length = unit(2, units = "mm"),
plot.title = element_text(face = "bold", hjust = 0.5, size = 12),
axis.title = element_text(size = 9, colour = "gray30"),
axis.text.y = element_text(hjust = 1, size = 5, colour = "gray40"),
axis.text.x = element_text(angle = 90, hjust = 1, size = 5, colour = "gray40"),
legend.title=element_text(face = "bold", hjust = 0.5, size=8),
legend.text=element_text(size=6)
)Use girafe
ggraph
The following code is adapted from http://www.pieceofk.fr/?p=431.
library(tidyverse)
library(stringr)
library(igraph)
library(tidygraph)
library(ggraph)
library(magrittr)
library(ggiraph)
aut <- readRDS("aut.RDS")
aut_list <- aut %>%
unlist() %>%
dplyr::as_data_frame() %>%
count(value) %>%
rename(Name = value, Package = n) %>%
mutate(Name = str_replace_all(Name, "'", " ")) ## Warning: `as_data_frame()` is deprecated, use `as_tibble()` (but mind the new semantics).
## This warning is displayed once per session.
edge_list <- aut %>%
purrr::map(combn, m = 2) %>%
do.call("cbind", .) %>%
t() %>%
dplyr::as_data_frame() %>%
arrange(V1, V2) %>%
count(V1, V2)
g <- edge_list %>%
select(V1, V2) %>%
as.matrix() %>%
graph.edgelist(directed = FALSE) %>%
as_tbl_graph() %>%
activate("edges") %>%
mutate(Weight = edge_list$n) %>%
activate("nodes") %>%
rename(Name = name) %>%
mutate(Component = group_components()) %>%
filter(Component == names(table(Component))[which.max(table(Component))])
g <- g %>%
left_join(aut_list) %>%
filter(Package > 4) %>%
mutate(Component = group_components()) %>%
filter(Component == names(table(Component))[which.max(table(Component))])We can now create the plot :
ggg <- ggraph(g, layout = 'lgl') +
geom_edge_fan(alpha = 0.1, edge_width = .2) +
geom_point_interactive(aes(x, y,
tooltip = Name, data_id = Name,
size = Package), alpha = .7, color = "#006699" ) +
theme_graph() +
theme(legend.position = "bottom")
girafe(ggobj = ggg, width_svg = 8, height_svg = 6) %>%
girafe_options(opts_zoom(max = 4))